<%@codepage="65001"%> 
<!--#include file="../Include/Conn.asp" -->
<!--#include file="../Include/inc.asp" -->
<!--#include file="../Include/Function.asp"-->
<!--#include file="seeion.asp"-->
<%call chkAdmin("|27") %>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<link href="images/style.css" rel="stylesheet" type="text/css">
<script language="JScript" runat="Server">
 function toObject(json) {
     eval("var o=" + json);
     return o;
 }
</script>
</head>
<body>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" bgcolor="#CCCCCC">
  <tr>
    <td height="30" class="topnav"><div>百度推送</div> </td>
  </tr>
  <tr>
    <td bgcolor="#FFFFFF" height="30"><div style="font-size:14px; padding-left:10px">注：使用百度主动推送时，必须在百度站长平台中添加要推送的网站域名，并平台上获取你自己的token填入后台附加参数配置中，否则会推送失败！</div> </td>
  </tr>
  <tr>
    <td bgcolor="#FFFFFF"><table width="200" border="0" cellspacing="0" cellpadding="6">
      <tr>
        <td><input type="button" name="Submit" value="生成百度SITEMAP.XML" onclick="javascript:if(confirm('确定生成!')){window.location.href='?action=siemap';}else{history.go(0);}"  class="btn"/></td>
        <td><input type="button" name="Submit" value="百度主动推送" onclick="window.location.href='?action=baidutui'"  class="btn"/></td>
      </tr>
    </table></td>
  </tr>
</table>
<%
if request.querystring("action")="siemap" then
Session("count") = 0
strURL = "http://"&request.servervariables("server_name")&""
Dim foolcat
foolcat = foolcat + "<?xml version=""1.0"" encoding=""utf-8""?>"&vbcrlf
foolcat = foolcat + "<!--Google Site Map File Generated by http://www.zychr.com SiteMap Time: " & return_RFC822_Date(Now, "GMT") & "-->"&vbcrlf
foolcat = foolcat + "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">"&vbcrlf
foolcat = foolcat + "<url>"&vbcrlf
foolcat = foolcat + "<loc>" & strURL & "</loc>"&vbcrlf
foolcat = foolcat + "<lastmod>" & FormatTime(Now, 1) & "</lastmod>"&vbcrlf
foolcat = foolcat + "<changefreq>always</changefreq>"&vbcrlf
foolcat = foolcat + "<priority>1.0</priority>"&vbcrlf
foolcat = foolcat + "</url>"&vbcrlf
foolcat = foolcat + "<url>"&vbcrlf
Session("count") = Session("count") + "1"
Set Rs = server.CreateObject("adodb.RecordSet")
SQL = "select * from [zych_Type] where isok=1 order by px_id asc"
Set Rs = conn.Execute (SQL)
Do Until Rs.EOF
ID = rs("SortID")
    foolcat = foolcat + "<url>"&vbcrlf
    foolcat = foolcat + "<loc>" &strURL&zych_listPath(rs("SortType"),rs("SortID"),rs("SortURL"))& "</loc>"&vbcrlf
    foolcat = foolcat + "<lastmod>"&FormatTime(now(), 1)&"</lastmod>"&vbcrlf
    foolcat = foolcat + "<changefreq>daily</changefreq>"&vbcrlf
    foolcat = foolcat + "<priority>0.8</priority>"&vbcrlf
    foolcat = foolcat + "</url>"&vbcrlf
    Session("count") = Session("count") + "1"
    Rs.movenext
Loop
Rs.Close
Set Rs = Nothing

Dim Rs, SQL
Set Rs = server.CreateObject("adodb.RecordSet")
SQL = "select * from Content where isok=1 and addtime<#"&now()&"# order by Cid desc"
Set Rs = conn.Execute (SQL)
Do Until Rs.EOF
ID = rs("Cid")
    foolcat = foolcat + "<url>"&vbcrlf
    foolcat = foolcat + "<loc>" &strURL&zych_show_url(rs("SortID"),ID)& "</loc>"&vbcrlf
    foolcat = foolcat + "<lastmod>"&FormatTime(Rs("addtime"), 1)&"</lastmod>"&vbcrlf
    foolcat = foolcat + "<changefreq>daily</changefreq>"&vbcrlf
    foolcat = foolcat + "<priority>0.8</priority>"&vbcrlf
    foolcat = foolcat + "</url>"&vbcrlf
    Session("count") = Session("count") + "1"
    Rs.movenext
Loop
Rs.Close
Set Rs = Nothing

foolcat = foolcat + "</urlset>"&vbcrlf

foolcat = "" + foolcat + ""
foolcat = "" & foolcat & ""
FolderPath = Server.MapPath("..")
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile(FolderPath&"\sitemap.xml")
fout.WriteLine foolcat
fout.Close
Set fout = Nothing
conn.Close
Set conn = Nothing

Function return_RFC822_Date(ByVal myDate, ByVal TimeZone)
    Dim myDay, myDays, myMonth, myYear
    Dim myHours, myMinutes, mySeconds

    myDate = CDate(myDate)
    myDay = EnWeekDayName(myDate)
    myDays = Right("00" & Day(myDate), 2)
    myMonth = EnMonthName(myDate)
    myYear = Year(myDate)
    myHours = Right("00" & Hour(myDate), 2)
    myMinutes = Right("00" & Minute(myDate), 2)
    mySeconds = Right("00" & Second(myDate), 2)

    return_RFC822_Date = myDay&", "& _
                         myDays&" "& _
                         myMonth&" "& _
                         myYear&" "& _
                         myHours&":"& _
                         myMinutes&":"& _
                         mySeconds&" "& _
                         " " & TimeZone
End Function

Function EnWeekDayName(InputDate)
    Dim Result
    Select Case Weekday(InputDate, 1)
        Case 1
            Result = "Sun"
        Case 2
            Result = "Mon"
        Case 3
            Result = "Tue"
        Case 4
            Result = "Wed"
        Case 5
            Result = "Thu"
        Case 6
            Result = "Fri"
        Case 7
            Result = "Sat"
    End Select
    EnWeekDayName = Result
End Function

Function EnMonthName(InputDate)
    Dim Result
    Select Case Month(InputDate)
        Case 1
            Result = "Jan"
        Case 2
            Result = "Feb"
        Case 3
            Result = "Mar"
        Case 4
            Result = "Apr"
        Case 5
            Result = "May"
        Case 6
            Result = "Jun"
        Case 7
            Result = "Jul"
        Case 8
            Result = "Aug"
        Case 9
            Result = "Sep"
        Case 10
            Result = "Oct"
        Case 11
            Result = "Nov"
        Case 12
            Result = "Dec"
    End Select
    EnMonthName = Result
End Function

Function FormatTime(sTime, iFmt)
    Dim sTemp
    If IsNull(sTime) Or sTime = "" Then
        FormatTime = Year(Date) & "-" & Right("0" & Month(Date), 2) & "-" & Right("0" & Day(Date), 2)
        Exit Function
    End If
    sTemp = Year(sTime) & "-" & Right("0" & Month(sTime), 2) & "-" & Right("0" & Day(sTime), 2)
    Select Case iFmt
        Case 0
            FormatTime = sTemp
        Case 1
            FormatTime = sTemp& "T" & Right("0" & Hour(sTime), 2) & ":" & Right("0" & Minute(sTime), 2) & "+08:00"
    End Select
End Function
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" bgcolor=""#CCCCCC"" style=""margin-top:10px"">"
Response.Write "<tr>"
Response.Write "<td height=""30"" class=""topnav""><div>SiteMap生成</div></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td align=""center"" bgcolor=""#FFFFFF"">"
Response.Write "<div style=""line-height:28px"">自由策划为您提供适用于baidu的SiteMap.xml文件生成完毕，共<font color=""#FF0000"">"&Session("count")&"</font>条记录被索引</div>"
Response.Write "<div style=""line-height:28px"">点击查看<a href=""../sitemap.xml"" target=""_blank""><font color=""#FF0000"">SiteMap.xml</font></a>"
Response.Write "<a href=""http://zhanzhang.baidu.com/linksubmit/index"" target=""_blank"">立即提交至百度</a></div>"
Response.Write "</td>"
Response.Write "</tr>"
Response.Write "</table>"
end if


if request.querystring("action")="baidutui" then

'百度主推
function BytesToBstr(body,Cset) 
   dim objstream 
    set objstream = Server.CreateObject("adodb.stream")
    objstream.Type = 1 
    objstream.Mode =3 
    objstream.Open 
    objstream.Write body 
    objstream.Position = 0 
    objstream.Type = 2 
    objstream.Charset = Cset 
    BytesToBstr = objstream.ReadText 
    objstream.Close 
    set objstream = nothing 
End function

function PostHTTPPage(url,data) 
    dim Http 
    set Http=server.createobject("MSXML2.SERVERXMLHTTP.3.0")
    Http.open "POST",url,false 
    Http.setRequestHeader "CONTENT-TYPE", "text/plain" 
    Http.send(data) 
    if Http.readystate<>4 then 
        exit function 
    End if
    PostHTTPPage=bytesToBSTR(Http.responseBody,"utf-8") 
    set http=nothing 
    if err.number<>0 then err.Clear 
End function

strURL = "http://"&request.servervariables("server_name")&""
Set Rs = server.CreateObject("adodb.RecordSet")
SQL = "select * from [zych_Type] where isok=1 order by px_id asc"
Set Rs = conn.Execute (SQL)
Do Until Rs.EOF
sitemap = sitemap&" "&strURL&zych_listPath(rs("SortType"),rs("SortID"),rs("SortURL"))&","&vbcrlf
Rs.movenext
Loop
Rs.Close
Set Rs = Nothing
Posthtml=PostHTTPPage("http://data.zz.baidu.com/urls?site="&request.servervariables("server_name")&"&token="&Token&"",sitemap)

Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" bgcolor=""#CCCCCC"" style=""margin-top:10px"">"
Response.Write "<tr>"
Response.Write "<td height=""30"" class=""topnav""><div>百度主动推送</div></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td align=""center"" bgcolor=""#FFFFFF""><div style=""line-height:28px"">"

Response.Write Posthtml
'response.clear
json = Posthtml
Set json = toObject(json)
if instr(Posthtml,"success")>0 then
Response.Write "百度主动推送成功<font color=""#FF0000""> "&json.success&"</font> 条；剩余配额<font color=""#FF0000"">"&json.remain&" </font>条"
else
Response.Write "百度主动推送失败！返回代码 => "&Posthtml
end if
Set json = Nothing

Response.Write "</div></td>"
Response.Write "</tr>"
Response.Write "</table>"

end if
%>
</body>
</html>
